home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / Finger 1.3.5 / Tokens / MACENVY.p < prev    next >
Encoding:
Text File  |  1991-11-26  |  7.0 KB  |  274 lines  |  [TEXT/PJMM]
  1. unit MACENVY;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ParameterDef;
  7.  
  8.     procedure Main (var p: parameterRecord);
  9.  
  10. implementation
  11.  
  12.     uses
  13.         NumSubs;
  14.  
  15.     const
  16.         AMegaByte = 1024 * 1024;
  17.  
  18.     procedure Main (var p: parameterRecord);
  19.  
  20.         type
  21.             shortStr = string[15];
  22.  
  23.         function GDecStr (selector: OSType): shortStr;
  24.             var
  25.                 err: OSErr;
  26.                 response: longint;
  27.         begin
  28.             GDecStr := '';
  29.             err := Gestalt(selector, response);
  30.             if err = noErr then begin
  31.                 GDecStr := DecStr(response);
  32.             end; (* if *)
  33.         end; (* GDecStr *)
  34.  
  35.         function GMemStr (selector: OSType): Str31;
  36.             var
  37.                 err: OSErr;
  38.                 response: longint;
  39.         begin
  40.             GMemStr := '';
  41.             err := Gestalt(selector, response);
  42.             if err = noErr then begin
  43.                 if (response div 1024) < 1024 then begin
  44.                     GMemStr := concat(DecStr(response div 1024), 'K (', HexL(response), ')');
  45.                 end
  46.                 else begin
  47.                     GMemStr := concat(DecStr(response div 1024 div 1024), 'M (', HexL(response), ')');
  48.                 end; (* if *)
  49.             end; (* if *)
  50.         end; (* GMemStr *)
  51.  
  52.         function GVerStr (selector: OSType): shortStr;
  53.             var
  54.                 err: OSErr;
  55.                 response: longint;
  56.         begin
  57.             GVerStr := '';
  58.             err := Gestalt(selector, response);
  59.             if err = noErr then begin
  60.                 GVerStr := concat(DecStr(band(bsr(response, 8), $F)), '.', DecStr(band(bsr(response, 4), $F)), '.', DecStr(band(bsr(response, 0), $F)));
  61.             end; (* if *)
  62.         end; (* GVerStr *)
  63.  
  64.         procedure AddChar (ch: char);
  65.         begin
  66.             if p.offset < p.hlength then begin
  67.                 BlockMove(ptr(longint(@ch) + 1), ptr(longInt(p.fingeroutput^) + p.offset), 1);
  68.                 p.offset := p.offset + 1;
  69.             end;
  70.         end; (* AddChar *)
  71.  
  72.         var
  73.             response: longint;
  74.             count: integer;
  75.             i, row, col: integer;
  76.             bit: integer;
  77.             err: OSErr;
  78.             chh: CharsHandle;
  79.     begin
  80.         p.returnValue^ := '';
  81.  
  82.         if p.param^ = 'APPLETALK' then begin
  83.             p.returnValue^ := GDecStr(gestaltAppleTalkVersion);
  84.         end; (* if *)
  85.  
  86.         if p.param^ = 'FPU' then begin
  87.             err := Gestalt(gestaltFPUType, response);
  88.             if err = noErr then begin
  89.                 case response of
  90.                     gestalt68881: 
  91.                         p.returnValue^ := '68881';
  92.                     gestalt68882: 
  93.                         p.returnValue^ := '68882';
  94.                     gestalt68040FPU: 
  95.                         p.returnValue^ := '68040 FPU (Aren''t you jealous?)';
  96.                     otherwise
  97.                         p.returnValue^ := 'unknown';
  98.                 end; (* case *)
  99.             end; (* if *)
  100.         end; (* if *)
  101.  
  102.         if p.param^ = 'KEYBOARD' then begin
  103.             err := Gestalt(gestaltKeyboardType, response);
  104.             if err = noErr then begin
  105.                 case response of
  106.                     gestaltMacKbd: 
  107.                         p.returnValue^ := 'Macintosh Keyboard';
  108.                     gestaltMacAndPad: 
  109.                         p.returnValue^ := 'Macintosh Keyboard and KeyPad';
  110.                     gestaltMacPlusKbd: 
  111.                         p.returnValue^ := 'Macintosh Plus Keyboard';
  112.                     gestaltExtADBKbd: 
  113.                         p.returnValue^ := 'Extended ADB Keyboard';
  114.                     gestaltStdADBKbd: 
  115.                         p.returnValue^ := 'Standard ADB Keyboard';
  116.                     gestaltPrtblADBKbd: 
  117.                         p.returnValue^ := 'Portable Standard ADB Keyboard';
  118.                     gestaltPrtblISOKbd: 
  119.                         p.returnValue^ := 'Portable ISO ADB Keyboard';
  120.                     gestaltStdISOADBKbd: 
  121.                         p.returnValue^ := 'ISO Standard Keyboard';
  122.                     gestaltExtISOADBKbd: 
  123.                         p.returnValue^ := 'ISO Extended Keyboard';
  124.                     gestaltADBKbdII: 
  125.                         p.returnValue^ := 'ADB Keyboard II';
  126.                     gestaltADBISOKbdII: 
  127.                         p.returnValue^ := 'ISO ADB Keyboard II';
  128.                     otherwise
  129.                         p.returnValue^ := 'unknown';
  130.                 end; (* case *)
  131.             end; (* if *)
  132.         end; (* if *)
  133.  
  134.         if p.param^ = 'LOWMEMORY' then begin
  135.             p.returnValue^ := GDecStr(gestaltLowMemorySize);
  136.         end; (* if *)
  137.  
  138.         if (p.param^ = 'RAMSIZE') or (p.param^ = 'LOGICALRAMSIZE') then begin
  139.             p.returnValue^ := GMemStr(gestaltLogicalRAMSize);
  140.         end; (* if *)
  141.  
  142.         if p.param^ = 'MACHINE' then begin
  143.             err := Gestalt(gestaltMachineType, response);
  144.             if err = noErr then begin
  145.                 GetIndString(p.returnValue^, kMachineNameStrID, response);
  146.             end; (* if *)
  147.         end; (* if *)
  148.  
  149.         if p.param^ = 'ICON' then begin
  150.             err := Gestalt(gestaltMachineIcon, response);
  151.             if err = noErr then begin
  152.                 chh := CharsHandle(GetResource('ICN#', LoWrd(response)));
  153.                 if chh <> nil then begin
  154.                     for row := 0 to 31 do begin
  155.                         for col := 0 to 3 do begin
  156.                             for bit := 7 downto 0 do begin
  157.                                 if btst(ord(chh^^[row * 4 + col]), bit) then begin
  158.                                     AddChar('X');
  159.                                     AddChar('X');
  160.                                 end
  161.                                 else begin
  162.                                     AddChar(' ');
  163.                                     AddChar(' ');
  164.                                 end; (* if *)
  165.                             end; (* for *)
  166.                         end; (* for *)
  167.                         AddChar(chr(13));
  168.                         AddChar(chr(10));
  169.                     end; (* for *)
  170.                 end; (* if *)
  171.             end; (* if *)
  172.         end; (* if *)
  173.  
  174.         if p.param^ = 'MMU' then begin
  175.             err := Gestalt(gestaltMMUType, response);
  176.             if err = noErr then begin
  177.                 case response of
  178.                     gestalt68851: 
  179.                         p.returnValue^ := '68851';
  180.                     gestalt68030MMU: 
  181.                         p.returnValue^ := '68030 MMU';
  182.                     gestalt68040MMU: 
  183.                         p.returnValue^ := '68040 MMU';
  184.                     otherwise
  185.                         p.returnValue^ := 'unknown';
  186.                 end; (* case *)
  187.             end; (* if *)
  188.         end; (* if *)
  189.  
  190.         if p.param^ = 'PAGESIZE' then begin
  191.             p.returnValue^ := GDecStr(gestaltLogicalPageSize);
  192.         end; (* if *)
  193.  
  194.         if p.param^ = 'CPU' then begin
  195.             err := Gestalt(gestaltProcessorType, response);
  196.             if err = noErr then begin
  197.                 case response of
  198.                     gestalt68000: 
  199.                         p.returnValue^ := '68000';
  200.                     gestalt68010: 
  201.                         p.returnValue^ := '68010 (Yes I know it''s obscure but I love it anyway)';
  202.                     gestalt68020: 
  203.                         p.returnValue^ := '68020';
  204.                     gestalt68030: 
  205.                         p.returnValue^ := '68030';
  206.                     gestalt68040: 
  207.                         p.returnValue^ := '68040';
  208.                     otherwise
  209.                         p.returnValue^ := 'unknown';
  210.                 end; (* case *)
  211.             end; (* if *)
  212.         end; (* if *)
  213.  
  214.         if p.param^ = 'QUICKDRAW' then begin
  215.             p.returnValue^ := GVerStr(gestaltQuickdrawVersion);
  216.         end; (* if *)
  217.  
  218.         if (p.param^ = 'REALRAMSIZE') or (p.param^ = 'PHYSICALRAMSIZE') then begin
  219.             p.returnValue^ := GMemStr(gestaltPhysicalRAMSize);
  220.         end; (* if *)
  221.  
  222.         if p.param^ = 'ROMSIZE' then begin
  223.             p.returnValue^ := GMemStr(gestaltROMSize);
  224.         end; (* if *)
  225.  
  226.         if p.param^ = 'ROM' then begin
  227.             err := Gestalt(gestaltROMVersion, response);
  228.             p.returnValue^ := HexW(LoWrd(response));
  229.         end; (* if *)
  230.  
  231.         if p.param^ = 'SLOTS' then begin
  232.             err := Gestalt(gestaltNuBusConnectors, response);
  233.             if err = noErr then begin
  234.                 count := 0;
  235.                 for i := 0 to 15 do begin
  236.                     if btst(response, i) then begin
  237.                         count := count + 1;
  238.                     end; (* if *)
  239.                 end; (* for *)
  240.                 p.returnValue^ := DecStr(count);
  241.             end; (* if *)
  242.         end; (* if *)
  243.  
  244.         if p.param^ = 'SOUND' then begin
  245.             err := Gestalt(gestaltSoundAttr, response);
  246.             if err = noErr then begin
  247.                 if btst(response, gestaltStereoCapability) then begin
  248.                     p.returnValue^ := 'Stereo';
  249.                 end
  250.                 else begin
  251.                     p.returnValue^ := 'Mono';
  252.                 end; (* if *)
  253.                 p.returnValue^ := concat(p.returnValue^, ' sound');
  254.                 if btst(response, gestaltHasSoundInputDevice) then begin
  255.                     p.returnValue^ := concat(p.returnValue^, ' with sound input');
  256.                 end;
  257.             end; (* if *)
  258.         end; (* if *)
  259.  
  260.         if p.param^ = 'SYSTEM' then begin
  261.             p.returnValue^ := GVerStr(gestaltSystemVersion);
  262.         end; (* if *)
  263.  
  264.         if p.param^ = 'TEXTEDIT' then begin
  265.             p.returnValue^ := GDecStr(gestaltTextEditVersion);
  266.         end; (* if *)
  267.  
  268.         if p.param^ = 'GESTALT' then begin
  269.             p.returnValue^ := GDecStr(gestaltVersion);
  270.         end; (* if *)
  271.  
  272.     end;
  273.  
  274. end. (* MACENVY *)